home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / DATEUTIL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  16.6 KB  |  627 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11.  
  12.  
  13. unit DateUtil;
  14.  
  15. {$I RX.INC}
  16. {$B-,V-,R-,Q-}
  17.  
  18. interface
  19.  
  20.   uses RTLConsts;
  21.  
  22. function CurrentYear: Word;
  23. function IsLeapYear(AYear: Integer): Boolean;
  24. function DaysPerMonth(AYear, AMonth: Integer): Integer;
  25. function FirstDayOfPrevMonth: TDateTime;
  26. function LastDayOfPrevMonth: TDateTime;
  27. function FirstDayOfNextMonth: TDateTime;
  28. function ExtractDay(ADate: TDateTime): Word;
  29. function ExtractMonth(ADate: TDateTime): Word;
  30. function ExtractYear(ADate: TDateTime): Word;
  31. function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
  32. function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
  33. function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
  34. function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
  35. function ValidDate(ADate: TDateTime): Boolean;
  36. procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
  37. function MonthsBetween(Date1, Date2: TDateTime): Double;
  38. function DaysInPeriod(Date1, Date2: TDateTime): Longint;
  39.   { Count days between Date1 and Date2 + 1, so if Date1 = Date2 result = 1 }
  40. function DaysBetween(Date1, Date2: TDateTime): Longint;
  41.   { The same as previous but if Date2 < Date1 result = 0 }
  42.  
  43. function IncTime(ATime: TDateTime; Hours, Minutes, Seconds, MSecs: Integer): TDateTime;
  44. function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
  45. function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
  46. function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
  47. function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
  48. function CutTime(ADate: TDateTime): TDateTime; { Set time to 00:00:00:00 }
  49.  
  50. type
  51.   TDateOrder = (doMDY, doDMY, doYMD);
  52.   TDayOfWeekName = (Sun, Mon, Tue, Wed, Thu, Fri, Sat);
  53.   TDaysOfWeek = set of TDayOfWeekName;
  54.  
  55. { String to date conversions }
  56. function GetDateOrder(const DateFormat: string): TDateOrder;
  57. function MonthFromName(const S: string; MaxLen: Byte): Byte;
  58. function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
  59. function StrToDateFmt(const DateFormat, S: string): TDateTime;
  60. function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
  61. function DefDateFormat(FourDigitYear: Boolean): string;
  62. function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
  63.  
  64. {$IFDEF WIN32}
  65. function FormatLongDate(Value: TDateTime): string;
  66. function FormatLongDateTime(Value: TDateTime): string;
  67. {$ENDIF}
  68.  
  69. const
  70.   DefaultDateOrder = doDMY;
  71.  
  72. {$IFDEF USE_FOUR_DIGIT_YEAR}
  73. var
  74.   FourDigitYear: Boolean;
  75. {$ELSE}
  76. function FourDigitYear: Boolean;
  77. {$ENDIF USE_FOUR_DIGIT_YEAR}
  78.  
  79. const
  80.   CenturyOffset: Byte = 60;
  81. {$IFDEF WIN32}
  82.   NullDate: TDateTime = {-693594} 0;
  83. {$ELSE}
  84.   NullDate: TDateTime = 0;
  85. {$ENDIF}
  86.  
  87. implementation
  88.  
  89. uses SysUtils, {$IFDEF WIN32} Windows, {$ENDIF} Consts, rxStrUtils;
  90.  
  91. function IsLeapYear(AYear: Integer): Boolean;
  92. begin
  93.   Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
  94. end;
  95.  
  96. function DaysPerMonth(AYear, AMonth: Integer): Integer;
  97. const
  98.   DaysInMonth: array[1..12] of Integer =
  99.     (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  100. begin
  101.   Result := DaysInMonth[AMonth];
  102.   if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
  103. end;
  104.  
  105. function FirstDayOfNextMonth: TDateTime;
  106. var
  107.   Year, Month, Day: Word;
  108. begin
  109.   DecodeDate(Date, Year, Month, Day);
  110.   Day := 1;
  111.   if Month < 12 then Inc(Month)
  112.   else begin
  113.     Inc(Year);
  114.     Month := 1;
  115.   end;
  116.   Result := EncodeDate(Year, Month, Day);
  117. end;
  118.  
  119. function FirstDayOfPrevMonth: TDateTime;
  120. var
  121.   Year, Month, Day: Word;
  122. begin
  123.   DecodeDate(Date, Year, Month, Day);
  124.   Day := 1;
  125.   if Month > 1 then Dec(Month)
  126.   else begin
  127.     Dec(Year);
  128.     Month := 12;
  129.   end;
  130.   Result := EncodeDate(Year, Month, Day);
  131. end;
  132.  
  133. function LastDayOfPrevMonth: TDateTime;
  134. var
  135.   D: TDateTime;
  136.   Year, Month, Day: Word;
  137. begin
  138.   D := FirstDayOfPrevMonth;
  139.   DecodeDate(D, Year, Month, Day);
  140.   Day := DaysPerMonth(Year, Month);
  141.   Result := EncodeDate(Year, Month, Day);
  142. end;
  143.  
  144. function ExtractDay(ADate: TDateTime): Word;
  145. var
  146.   M, Y: Word;
  147. begin
  148.   DecodeDate(ADate, Y, M, Result);
  149. end;
  150.  
  151. function ExtractMonth(ADate: TDateTime): Word;
  152. var
  153.   D, Y: Word;
  154. begin
  155.   DecodeDate(ADate, Y, Result, D);
  156. end;
  157.  
  158. function ExtractYear(ADate: TDateTime): Word;
  159. var
  160.   D, M: Word;
  161. begin
  162.   DecodeDate(ADate, Result, M, D);
  163. end;
  164.  
  165. function IncDate(ADate: TDateTime; Days, Months, Years: Integer): TDateTime;
  166. var
  167.   D, M, Y: Word;
  168.   Day, Month, Year: Longint;
  169. begin
  170.   DecodeDate(ADate, Y, M, D);
  171.   Year := Y; Month := M; Day := D;
  172.   Inc(Year, Years);
  173.   Inc(Year, Months div 12);
  174.   Inc(Month, Months mod 12);
  175.   if Month < 1 then begin
  176.     Inc(Month, 12);
  177.     Dec(Year);
  178.   end
  179.   else if Month > 12 then begin
  180.     Dec(Month, 12);
  181.     Inc(Year);
  182.   end;
  183.   if Day > DaysPerMonth(Year, Month) then Day := DaysPerMonth(Year, Month);
  184.   Result := EncodeDate(Year, Month, Day) + Days + Frac(ADate);
  185. end;
  186.  
  187. procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
  188. { Corrected by Anatoly A. Sanko (2:450/73) }
  189. var
  190.   DtSwap: TDateTime;
  191.   Day1, Day2, Month1, Month2, Year1, Year2: Word;
  192. begin
  193.   if Date1 > Date2 then begin
  194.     DtSwap := Date1;
  195.     Date1 := Date2;
  196.     Date2 := DtSwap;
  197.   end;
  198.   DecodeDate(Date1, Year1, Month1, Day1);
  199.   DecodeDate(Date2, Year2, Month2, Day2);
  200.   Years := Year2 - Year1;
  201.   Months := 0;
  202.   Days := 0;
  203.   if Month2 < Month1 then begin
  204.     Inc(Months, 12);
  205.     Dec(Years);
  206.   end;
  207.   Inc(Months, Month2 - Month1);
  208.   if Day2 < Day1 then begin
  209.     Inc(Days, DaysPerMonth(Year1, Month1));
  210.     if Months = 0 then begin
  211.       Dec(Years);
  212.       Months := 11;
  213.     end
  214.     else Dec(Months);
  215.   end;
  216.   Inc(Days, Day2 - Day1);
  217. end;
  218.  
  219. function IncDay(ADate: TDateTime; Delta: Integer): TDateTime;
  220. begin
  221.   Result := ADate + Delta;
  222. end;
  223.  
  224. function IncMonth(ADate: TDateTime; Delta: Integer): TDateTime;
  225. begin
  226.   Result := IncDate(ADate, 0, Delta, 0);
  227. end;
  228.  
  229. function IncYear(ADate: TDateTime; Delta: Integer): TDateTime;
  230. begin
  231.   Result := IncDate(ADate, 0, 0, Delta);
  232. end;
  233.  
  234. function MonthsBetween(Date1, Date2: TDateTime): Double;
  235. var
  236.   D, M, Y: Word;
  237. begin
  238.   DateDiff(Date1, Date2, D, M, Y);
  239.   Result := 12 * Y + M;
  240.   if (D > 1) and (D < 7) then Result := Result + 0.25
  241.   else if (D >= 7) and (D < 15) then Result := Result + 0.5
  242.   else if (D >= 15) and (D < 21) then Result := Result + 0.75
  243.   else if (D >= 21) then Result := Result + 1;
  244. end;
  245.  
  246. function IsValidDate(Y, M, D: Word): Boolean;
  247. begin
  248.   Result := (Y >= 1) and (Y <= 9999) and (M >= 1) and (M <= 12) and
  249.     (D >= 1) and (D <= DaysPerMonth(Y, M));
  250. end;
  251.  
  252. function ValidDate(ADate: TDateTime): Boolean;
  253. var
  254.   Year, Month, Day: Word;
  255. begin
  256.   try
  257.     DecodeDate(ADate, Year, Month, Day);
  258.     Result := IsValidDate(Year, Month, Day);
  259.   except
  260.     Result := False;
  261.   end;
  262. end;
  263.  
  264. function DaysInPeriod(Date1, Date2: TDateTime): Longint;
  265. begin
  266.   if ValidDate(Date1) and ValidDate(Date2) then
  267.     Result := Abs(Trunc(Date2) - Trunc(Date1)) + 1
  268.   else Result := 0;
  269. end;
  270.  
  271. function DaysBetween(Date1, Date2: TDateTime): Longint;
  272. begin
  273.   Result := Trunc(Date2) - Trunc(Date1) + 1;
  274.   if Result < 0 then Result := 0;
  275. end;
  276.  
  277. function IncTime(ATime: TDateTime; Hours, Minutes, Seconds,
  278.   MSecs: Integer): TDateTime;
  279. begin
  280.   Result := ATime + (Hours div 24) + (((Hours mod 24) * 3600000 +
  281.     Minutes * 60000 + Seconds * 1000 + MSecs) / MSecsPerDay);
  282.   if Result < 0 then Result := Result + 1;
  283. end;
  284.  
  285. function IncHour(ATime: TDateTime; Delta: Integer): TDateTime;
  286. begin
  287.   Result := IncTime(ATime, Delta, 0, 0, 0);
  288. end;
  289.  
  290. function IncMinute(ATime: TDateTime; Delta: Integer): TDateTime;
  291. begin
  292.   Result := IncTime(ATime, 0, Delta, 0, 0);
  293. end;
  294.  
  295. function IncSecond(ATime: TDateTime; Delta: Integer): TDateTime;
  296. begin
  297.   Result := IncTime(ATime, 0, 0, Delta, 0);
  298. end;
  299.  
  300. function IncMSec(ATime: TDateTime; Delta: Integer): TDateTime;
  301. begin
  302.   Result := IncTime(ATime, 0, 0, 0, Delta);
  303. end;
  304.  
  305. function CutTime(ADate: TDateTime): TDateTime;
  306. begin
  307.   Result := Trunc(ADate);
  308. end;
  309.  
  310. function CurrentYear: Word; 
  311. var
  312.   SystemTime: TSystemTime;
  313. begin
  314.   GetLocalTime(SystemTime);
  315.   Result := SystemTime.wYear;
  316. end;
  317.  
  318. { String to date conversions. Copied from SYSUTILS.PAS unit. }
  319.  
  320. procedure ScanBlanks(const S: string; var Pos: Integer);
  321. var
  322.   I: Integer;
  323. begin
  324.   I := Pos;
  325.   while (I <= Length(S)) and (S[I] = ' ') do Inc(I);
  326.   Pos := I;
  327. end;
  328.  
  329. function ScanNumber(const S: string; MaxLength: Integer; var Pos: Integer;
  330.   var Number: Longint): Boolean;
  331. var
  332.   I: Integer;
  333.   N: Word;
  334. begin
  335.   Result := False;
  336.   ScanBlanks(S, Pos);
  337.   I := Pos;
  338.   N := 0;
  339.   while (I <= Length(S)) and (Longint(I - Pos) < MaxLength) and
  340.     (S[I] in ['0'..'9']) and (N < 1000) do
  341.   begin
  342.     N := N * 10 + (Ord(S[I]) - Ord('0'));
  343.     Inc(I);
  344.   end;
  345.   if I > Pos then begin
  346.     Pos := I;
  347.     Number := N;
  348.     Result := True;
  349.   end;
  350. end;
  351.  
  352. function ScanChar(const S: string; var Pos: Integer; Ch: Char): Boolean;
  353. begin
  354.   Result := False;
  355.   ScanBlanks(S, Pos);
  356.   if (Pos <= Length(S)) and (S[Pos] = Ch) then begin
  357.     Inc(Pos);
  358.     Result := True;
  359.   end;
  360. end;
  361.  
  362. {$IFDEF RX_D3}
  363. procedure ScanToNumber(const S: string; var Pos: Integer);
  364. begin
  365.   while (Pos <= Length(S)) and not (S[Pos] in ['0'..'9']) do begin
  366.     if S[Pos] in LeadBytes then Inc(Pos);
  367.     Inc(Pos);
  368.   end;
  369. end;
  370. {$ENDIF}
  371.  
  372. function GetDateOrder(const DateFormat: string): TDateOrder;
  373. var
  374.   I: Integer;
  375. begin
  376.   Result := DefaultDateOrder;
  377.   I := 1;
  378.   while I <= Length(DateFormat) do begin
  379.     case Chr(Ord(DateFormat[I]) and $DF) of
  380. {$IFDEF RX_D3}
  381.       'E': Result := doYMD;
  382. {$ENDIF}
  383.       'Y': Result := doYMD;
  384.       'M': Result := doMDY;
  385.       'D': Result := doDMY;
  386.     else
  387.       Inc(I);
  388.       Continue;
  389.     end;
  390.     Exit;
  391.   end;
  392.   Result := DefaultDateOrder; { default }
  393. end;
  394.  
  395. function ExpandYear(Year: Integer): Integer;
  396. var
  397.   N: Longint;
  398. begin
  399.   Result := Year;
  400.   if Result < 100 then begin
  401.     N := CurrentYear - CenturyOffset;
  402.     Inc(Result, N div 100 * 100);
  403.     if (CenturyOffset > 0) and (Result < N) then
  404.       Inc(Result, 100);
  405.   end;
  406. end;
  407.  
  408. function ScanDate(const S, DateFormat: string; var Pos: Integer;
  409.   var Y, M, D: Integer): Boolean;
  410. var
  411.   DateOrder: TDateOrder;
  412.   N1, N2, N3: Longint;
  413. begin
  414.   Result := False;
  415.   Y := 0; M := 0; D := 0;
  416.   DateOrder := GetDateOrder(DateFormat);
  417. {$IFDEF RX_D3}
  418.   if ShortDateFormat[1] = 'g' then { skip over prefix text }
  419.     ScanToNumber(S, Pos);
  420. {$ENDIF RX_D3}
  421.   if not (ScanNumber(S, MaxInt, Pos, N1) and ScanChar(S, Pos, DateSeparator) and
  422.     ScanNumber(S, MaxInt, Pos, N2)) then Exit;
  423.   if ScanChar(S, Pos, DateSeparator) then begin
  424.     if not ScanNumber(S, MaxInt, Pos, N3) then Exit;
  425.     case DateOrder of
  426.       doMDY: begin Y := N3; M := N1; D := N2; end;
  427.       doDMY: begin Y := N3; M := N2; D := N1; end;
  428.       doYMD: begin Y := N1; M := N2; D := N3; end;
  429.     end;
  430.     Y := ExpandYear(Y);
  431.   end
  432.   else begin
  433.     Y := CurrentYear;
  434.     if DateOrder = doDMY then begin
  435.       D := N1; M := N2;
  436.     end
  437.     else begin
  438.       M := N1; D := N2;
  439.     end;
  440.   end;
  441.   ScanChar(S, Pos, DateSeparator);
  442.   ScanBlanks(S, Pos);
  443. {$IFDEF RX_D3}
  444.   if SysLocale.FarEast and (System.Pos('ddd', ShortDateFormat) <> 0) then
  445.   begin { ignore trailing text }
  446.     if ShortTimeFormat[1] in ['0'..'9'] then  { stop at time digit }
  447.       ScanToNumber(S, Pos)
  448.     else  { stop at time prefix }
  449.       repeat
  450.         while (Pos <= Length(S)) and (S[Pos] <> ' ') do Inc(Pos);
  451.         ScanBlanks(S, Pos);
  452.       until (Pos > Length(S)) or
  453.         (AnsiCompareText(TimeAMString, Copy(S, Pos, Length(TimeAMString))) = 0) or
  454.         (AnsiCompareText(TimePMString, Copy(S, Pos, Length(TimePMString))) = 0);
  455.   end;
  456. {$ENDIF RX_D3}
  457.   Result := IsValidDate(Y, M, D) and (Pos > Length(S));
  458. end;
  459.  
  460. function MonthFromName(const S: string; MaxLen: Byte): Byte;
  461. begin
  462.   if Length(S) > 0 then
  463.     for Result := 1 to 12 do begin
  464.       if (Length(LongMonthNames[Result]) > 0) and
  465.         (AnsiCompareText(Copy(S, 1, MaxLen),
  466.         Copy(LongMonthNames[Result], 1, MaxLen)) = 0) then Exit;
  467.     end;
  468.   Result := 0;
  469. end;
  470.  
  471. procedure ExtractMask(const Format, S: string; Ch: Char; Cnt: Integer;
  472.   var I: Integer; Blank, Default: Integer);
  473. var
  474.   Tmp: string[20];
  475.   J, L: Integer;
  476. begin
  477.   I := Default;
  478.   Ch := UpCase(Ch);
  479.   L := Length(Format);
  480.   if Length(S) < L then L := Length(S)
  481.   else if Length(S) > L then Exit;
  482.   J := Pos(MakeStr(Ch, Cnt), AnsiUpperCase(Format));
  483.   if J <= 0 then Exit;
  484.   Tmp := '';
  485.   while (UpCase(Format[J]) = Ch) and (J <= L) do begin
  486.     if S[J] <> ' ' then Tmp := Tmp + S[J];
  487.     Inc(J);
  488.   end;
  489.   if Tmp = '' then I := Blank
  490.   else if Cnt > 1 then begin
  491.     I := MonthFromName(Tmp, Length(Tmp));
  492.     if I = 0 then I := -1;
  493.   end
  494.   else I := StrToIntDef(Tmp, -1);
  495. end;
  496.  
  497. function ScanDateStr(const Format, S: string; var D, M, Y: Integer): Boolean;
  498. var
  499.   Pos: Integer;
  500. begin
  501.   ExtractMask(Format, S, 'm', 3, M, -1, 0); { short month name? }
  502.   if M = 0 then ExtractMask(Format, S, 'm', 1, M, -1, 0);
  503.   ExtractMask(Format, S, 'd', 1, D, -1, 1);
  504.   ExtractMask(Format, S, 'y', 1, Y, -1, CurrentYear);
  505.   Y := ExpandYear(Y);
  506.   Result := IsValidDate(Y, M, D);
  507.   if not Result then begin
  508.     Pos := 1;
  509.     Result := ScanDate(S, Format, Pos, Y, M, D);
  510.   end;
  511. end;
  512.  
  513. function InternalStrToDate(const DateFormat, S: string;
  514.   var Date: TDateTime): Boolean;
  515. var
  516.   D, M, Y: Integer;
  517. begin
  518.   if S = '' then begin
  519.     Date := NullDate;
  520.     Result := True;
  521.   end
  522.   else begin
  523.     Result := ScanDateStr(DateFormat, S, D, M, Y);
  524.     if Result then
  525.     try
  526.       Date := EncodeDate(Y, M, D);
  527.     except
  528.       Result := False;
  529.     end;
  530.   end;
  531. end;
  532.  
  533. function StrToDateFmt(const DateFormat, S: string): TDateTime;
  534. begin
  535.   if not InternalStrToDate(DateFormat, S, Result) then
  536.     raise EConvertError.CreateFmt({$IFDEF RX_D3} SInvalidDate {$ELSE}
  537.       LoadStr(SInvalidDate) {$ENDIF}, [S]);
  538. end;
  539.  
  540. function StrToDateDef(const S: string; Default: TDateTime): TDateTime;
  541. begin
  542.   if not InternalStrToDate(ShortDateFormat, S, Result) then
  543.     Result := Trunc(Default);
  544. end;
  545.  
  546. function StrToDateFmtDef(const DateFormat, S: string; Default: TDateTime): TDateTime;
  547. begin
  548.   if not InternalStrToDate(DateFormat, S, Result) then
  549.     Result := Trunc(Default);
  550. end;
  551.  
  552. function DefDateFormat(FourDigitYear: Boolean): string;
  553. begin
  554.   if FourDigitYear then begin
  555.     case GetDateOrder(ShortDateFormat) of
  556.       doMDY: Result := 'MM/DD/YYYY';
  557.       doDMY: Result := 'DD/MM/YYYY';
  558.       doYMD: Result := 'YYYY/MM/DD';
  559.     end;
  560.   end
  561.   else begin
  562.     case GetDateOrder(ShortDateFormat) of
  563.       doMDY: Result := 'MM/DD/YY';
  564.       doDMY: Result := 'DD/MM/YY';
  565.       doYMD: Result := 'YY/MM/DD';
  566.     end;
  567.   end;
  568. end;
  569.  
  570. function DefDateMask(BlanksChar: Char; FourDigitYear: Boolean): string;
  571. begin
  572.   if FourDigitYear then begin
  573.     case GetDateOrder(ShortDateFormat) of
  574.       doMDY, doDMY: Result := '!99/99/9999;1;';
  575.       doYMD: Result := '!9999/99/99;1;';
  576.     end;
  577.   end
  578.   else begin
  579.     case GetDateOrder(ShortDateFormat) of
  580.       doMDY, doDMY: Result := '!99/99/99;1;';
  581.       doYMD: Result := '!99/99/99;1;';
  582.     end;
  583.   end;
  584.   if Result <> '' then Result := Result + BlanksChar;
  585. end;
  586.  
  587. {$IFDEF WIN32}
  588.  
  589. function FormatLongDate(Value: TDateTime): string;
  590. var
  591.   Buffer: array[0..1023] of Char;
  592.   SystemTime: TSystemTime;
  593. begin
  594. {$IFDEF RX_D3}
  595.   DateTimeToSystemTime(Value, SystemTime);
  596. {$ELSE}
  597.   with SystemTime do begin
  598.     DecodeDate(Value, wYear, wMonth, wDay);
  599.     DecodeTime(Value, wHour, wMinute, wSecond, wMilliseconds);
  600.   end;
  601. {$ENDIF}
  602.   SetString(Result, Buffer, GetDateFormat(GetThreadLocale, DATE_LONGDATE,
  603.     @SystemTime, nil, Buffer, SizeOf(Buffer) - 1));
  604.   Result := TrimRight(Result);
  605. end;
  606.  
  607. function FormatLongDateTime(Value: TDateTime): string;
  608. begin
  609.   if Value <> NullDate then
  610.     Result := FormatLongDate(Value) + FormatDateTime(' tt', Value)
  611.   else Result := '';
  612. end;
  613.  
  614. {$ENDIF WIN32}
  615.  
  616. {$IFNDEF USE_FOUR_DIGIT_YEAR}
  617. function FourDigitYear: Boolean;
  618. begin
  619.   Result := Pos('YYYY', AnsiUpperCase(ShortDateFormat)) > 0;
  620. end;
  621. {$ENDIF}
  622.  
  623. {$IFDEF USE_FOUR_DIGIT_YEAR}
  624. initialization
  625.   FourDigitYear := Pos('YYYY', AnsiUpperCase(ShortDateFormat)) > 0;
  626. {$ENDIF}
  627. end.